home *** CD-ROM | disk | FTP | other *** search
/ LiquidLibrary 2005 February / LiquidLibrary 2005 February - Disc 1.iso / pc / Portfolio Browser / Filters / PDF / LIB / gs_fonts.ps < prev    next >
Text File  |  2003-01-03  |  33KB  |  1,031 lines
  1. %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This software is licensed to a single customer by Artifex Software Inc.
  4. % under the terms of a specific OEM agreement.
  5.  
  6. % $RCSfile$ $Revision$
  7. % Font initialization and management code.
  8.  
  9. % Define the default font.
  10. /defaultfontname /Courier def
  11.  
  12. % Define the name of the font map file.
  13. /defaultfontmap (Fontmap) def
  14.  
  15. % ------ End of editable parameters ------ %
  16.  
  17. % Define the UniqueIDs and organization XUID assigned to Aladdin.
  18. % UniqueIDs 5,066,501 - 5,066,580 are assigned as follows:
  19. %   01 and 02 for shareware Cyrillic
  20. %   33 through 67 for Type 1 versions of the Hershey fonts
  21. % UniqueIDs 5,115,501 - 5,115,600 are currently unassigned.
  22. /AladdinEnterprisesXUID 107 def
  23.  
  24. % If SUBSTFONT is defined, make it the default font.
  25. /SUBSTFONT where { pop /defaultfontname /SUBSTFONT load def } if
  26.  
  27. % Define a reliable way of accessing FontDirectory in systemdict.
  28. /.FontDirectory
  29. { /FontDirectory .systemvar
  30. } .bind odef
  31.  
  32. % If DISKFONTS is true, we load individual CharStrings as they are needed.
  33. % (This is intended primarily for machines with very small memories.)
  34. % In this case, we define another dictionary, parallel to FontDirectory,
  35. % that retains an open file for every font loaded.
  36. /FontFileDirectory 10 dict def
  37.  
  38. % Define a temporary string for local use, since using =string
  39. % interferes with some PostScript programs.
  40. /.fonttempstring 128 string def
  41.  
  42. % Split up a search path into individual directories or files.
  43. /.pathlist        % <path> .pathlist <dir1|file1> ...
  44.  {  { dup length 0 eq { pop exit } if
  45.       .filenamelistseparator search not { exit } if
  46.       exch pop exch
  47.     }
  48.    loop
  49.  } bind def
  50.  
  51. % Load a font name -> font file name map.
  52. userdict /Fontmap .FontDirectory maxlength dict put
  53. /.loadFontmap {        % <file> .loadFontmap -
  54.         % We would like to simply execute .definefontmap as we read,
  55.         % but we have to maintain backward compatibility with an older
  56.         % specification that makes later entries override earlier
  57.         % ones within the same file.
  58.    50 dict exch .readFontmap
  59.     { .definefontmap } forall
  60. } bind def
  61. /.readFontmap {        % <dict> <file> .readFontmap <dict>
  62.     { dup token not { closefile exit } if
  63.         % stack: dict file fontname
  64.       % This is a hack to get around the absurd habit of MS-DOS editors
  65.       % of adding an EOF character at the end of the file.
  66.       dup (\032) eq { pop closefile exit } if
  67.       1 index token not
  68.        { (Fontmap entry for ) print dup =only
  69.      ( has no associated file or alias name!  Giving up.) = flush
  70.      {.readFontmap} 0 get 1 .quit
  71.        } if
  72.       dup type dup /stringtype eq exch /nametype eq or not
  73.        { (Fontmap entry for ) print 1 index =only
  74.      ( has an invalid file or alias name!  Giving up.) = flush
  75.      {.readFontmap} 0 get 1 .quit
  76.        } if
  77.         % stack: dict file fontname filename|aliasname
  78.       1 index type /stringtype eq
  79.       1 index type /nametype eq and 1 index xcheck and
  80.       1 index /run eq 2 index /.runlibfile eq or and {
  81.         % This is an inclusion entry.
  82.     pop findlibfile { exch pop } { file } ifelse
  83.     2 index exch .readFontmap pop
  84.       } {
  85.         % This is a real entry.
  86.         % Read and pop tokens until a semicolon.
  87.        { 2 index token not
  88.       { (Fontmap entry for ) print 1 index =only
  89.         ( ends prematurely!  Giving up.) = flush
  90.         {.loadFontmap} 0 get 1 .quit
  91.       } if
  92.      dup /; eq { pop 3 index 3 1 roll .growput exit } if
  93.      pop
  94.        } loop
  95.       } ifelse
  96.     } loop
  97. } bind def
  98. % Add an entry in Fontmap.  We redefine this if the Level 2
  99. % resource machinery is loaded.
  100. /.definefontmap            % <fontname> <file|alias> .definefontmap -
  101.  {        % Since Fontmap is global, make sure the values are storable.
  102.    .currentglobal 3 1 roll true .setglobal
  103.    dup type /stringtype eq
  104.     { dup .gcheck not { dup length string copy } if
  105.     }
  106.    if
  107.    Fontmap 3 -1 roll 2 copy .knownget
  108.     {        % Add an element to the end of the existing value,
  109.         % unless it's the same as the current last element.
  110.       mark exch aload pop counttomark 4 add -1 roll
  111.       2 copy eq { cleartomark pop pop } { ] readonly .growput } ifelse
  112.     }
  113.     {        % Make a new entry.
  114.       mark 4 -1 roll ] readonly .growput
  115.     }
  116.    ifelse .setglobal
  117.  } bind def
  118.  
  119. % Parse a font file just enough to find the FontName or FontType.
  120. /.findfontvalue {    % <file> <key> .findfontvalue <value> true
  121.             % <file> <key> .findfontvalue false
  122.             % Closes the file in either case.
  123.   exch dup read not { -1 } if
  124.   2 copy unread 16#80 eq {
  125.     dup (xxxxxx) readstring pop pop        % skip .PFB header
  126.   } if
  127.   {        % Stack: key file
  128.         % Protect ourselves against syntax errors here.
  129.     dup { token } stopped { pop false exit } if
  130.     not { false exit } if        % end of file
  131.     dup /eexec eq { pop false exit } if        % reached eexec section
  132.     dup /Subrs eq { pop false exit } if        % Subrs without eexec
  133.     dup /CharStrings eq { pop false exit } if    % CharStrings without eexec
  134.     dup 3 index eq
  135.      { xcheck not { dup token exit } if }    % found key
  136.      { pop }
  137.     ifelse
  138.   } loop
  139.         % Stack: key file value true   (or)
  140.         % Stack: key file false
  141.   dup { 4 } { 3 } ifelse -2 roll closefile pop
  142. } bind def
  143. /.findfontname
  144.  { /FontName .findfontvalue
  145.  } bind def
  146.  
  147. % If there is no FONTPATH, try to get one from the environment.
  148. NOFONTPATH { /FONTPATH () def } if
  149. /FONTPATH where
  150.  { pop }
  151.  { /FONTPATH (GS_FONTPATH) getenv not { () } if def }
  152. ifelse
  153. FONTPATH length 0 eq { (%END FONTPATH) .skipeof } if
  154. /FONTPATH [ FONTPATH .pathlist ] def
  155.  
  156. % Scan directories looking for plausible fonts.  "Plausible" means that
  157. % the file begins with %!PS-AdobeFont or %!FontType1, or with \200\001
  158. % followed by four arbitrary bytes and then either of these strings.
  159. % To speed up the search, we skip any file whose name appears in
  160. % the Fontmap (with any extension and upper/lower case variation) already,
  161. % and any file whose extension definitely indicates it is not a font.
  162. %
  163. % NOTE: The current implementation of this procedure is somewhat Unix/DOS-
  164. % specific.  It assumes that '/' and '\' are directory separators, and that
  165. % the part of a file name following the last '.' is the extension.
  166. %
  167. /.lowerstring        % <string> .lowerstring <lowerstring>
  168.  { 0 1 2 index length 1 sub
  169.     { 2 copy get dup 65 ge exch 90 le and
  170.        { 2 copy 2 copy get 32 add put }
  171.      if pop
  172.     }
  173.    for
  174.  } bind def
  175. /.splitfilename {    % <dir.../base.extn> .basename <base> <extn>
  176.         % Make the file name read-only to detect aliasing bugs.
  177.         % We really don't like doing this, but we've had one
  178.         % such bug already.
  179.   readonly {
  180.     (/) search { true } { (\\) search } ifelse { pop pop } { exit } ifelse
  181.   } loop
  182.   dup { (.) search { pop pop } { exit } ifelse } loop
  183.   2 copy eq {
  184.     pop ()
  185.   } {
  186.     exch dup length 2 index length 1 add sub 0 exch getinterval exch
  187.   } ifelse
  188. } bind def
  189. /.scanfontdict 1 dict def        % establish a binding
  190. /.scanfontbegin
  191.  {    % Construct the table of all file names already in Fontmap.
  192.    currentglobal true setglobal
  193.    .scanfontdict dup maxlength Fontmap length 2 add .max .setmaxlength
  194.    Fontmap
  195.     { exch pop
  196.        { dup type /stringtype eq
  197.       { .splitfilename pop .fonttempstring copy .lowerstring cvn
  198.         .scanfontdict exch true put
  199.       }
  200.       { pop
  201.       }
  202.      ifelse
  203.        }
  204.       forall
  205.     }
  206.    forall
  207.    setglobal
  208.  } bind def
  209. /.scanfontskip mark
  210.         % Strings are converted to names anyway, so....
  211.   /afm true
  212.   /bat true
  213.   /c true
  214.   /cmd true
  215.   /com true
  216.   /dir true
  217.   /dll true
  218.   /doc true
  219.   /drv true
  220.   /exe true
  221.   /fon true
  222.   /fot true
  223.   /h true
  224.   /o true
  225.   /obj true
  226.   /pfm true
  227.   /pss true        % Adobe Multiple Master font instances
  228.   /txt true
  229. .dicttomark def
  230. /.scan1fontstring 128 string def
  231. % %%BeginFont: is not per Adobe documentation, but a few fonts have it.
  232. /.scanfontheaders [(%!PS-Adobe*) (%!FontType*) (%%BeginFont:*)] def
  233. 0 .scanfontheaders { length max } forall 6 add    % extra for PFB header
  234. /.scan1fontfirst exch string def
  235. /.scanfontdir        % <dirname> .scanfontdir -
  236.  { currentglobal exch true setglobal
  237.    QUIET not { (Scanning ) print dup print ( for fonts...) print flush } if
  238.    (*) 2 copy .filenamedirseparator
  239.    dup (\\) eq { pop (\\\\) } if    % double \ for pattern match
  240.    exch concatstrings concatstrings
  241.    0 0 0 4 -1 roll    % found scanned files
  242.     {        % stack: <fontcount> <scancount> <filecount> <filename>
  243.       exch 1 add exch                   % increment filecount
  244.       dup .splitfilename .fonttempstring copy .lowerstring
  245.         % stack: <fontcount> <scancount> <filecount+1> <filename>
  246.         %    <BASE> <ext>
  247.       .scanfontskip exch known exch .scanfontdict exch known or
  248.        { pop
  249.         % stack: <fontcount> <scancount> <filecount+1>
  250.        }
  251.        { 3 -1 roll 1 add 3 1 roll
  252.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  253.      dup (r) { file } .internalstopped
  254.       { pop pop null ()
  255.         % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  256.         %    null ()
  257.       }
  258.       {
  259.         % On some platforms, the file operator will open directories,
  260.         % but an error will occur if we try to read from one.
  261.         % Handle this possibility here.
  262.         dup .scan1fontfirst { readstring } .internalstopped
  263.          { pop pop () }
  264.          { pop }
  265.         ifelse
  266.         % stack: <fontcount> <scancount+1> <filecount+1>
  267.         %    <filename> <file> <header>
  268.       }
  269.      ifelse
  270.         % Check for PFB file header.
  271.      dup (\200\001????*) .stringmatch
  272.       { dup length 6 sub 6 exch getinterval }
  273.      if
  274.         % Check for font file headers.
  275.      false .scanfontheaders
  276.       { 2 index exch .stringmatch or
  277.       }
  278.      forall exch pop
  279.       {    % stack: <fontcount> <scancount+1> <filecount+1> <filename>
  280.         %    <file>
  281.         dup 0 setfileposition .findfontname
  282.          { dup Fontmap exch known
  283.         { pop pop
  284.         }
  285.         { exch copystring exch
  286.           DEBUG { ( ) print dup =only flush } if
  287.           1 index .definefontmap
  288.           .splitfilename pop true .scanfontdict 3 1 roll .growput
  289.             % Increment fontcount.
  290.           3 -1 roll 1 add 3 1 roll
  291.         }
  292.            ifelse
  293.          }
  294.          { pop
  295.          }
  296.         ifelse
  297.       }
  298.         % .findfontname will have done a closefile in the above case.
  299.       { dup null eq { pop } { closefile } ifelse pop
  300.       }
  301.      ifelse
  302.        }
  303.       ifelse
  304.     }
  305.    .scan1fontstring filenameforall
  306.    QUIET
  307.     { pop pop pop }
  308.     { ( ) print =only ( files, ) print =only ( scanned, ) print
  309.       =only ( new fonts.) = flush
  310.     }
  311.    ifelse
  312.    setglobal
  313.  } bind def
  314.  
  315. %END FONTPATH
  316.  
  317. % Create the dictionary that registers the .buildfont procedure (called by
  318. % definefont) for each FontType.
  319. /buildfontdict 20 dict def
  320.  
  321. % Register Type 3 fonts, which are always supported, for definefont.
  322. buildfontdict 3 /.buildfont3 cvx put
  323.  
  324. % Register Type 0 fonts if they are supported.  Strictly speaking,
  325. % we should do this in its own file (gs_type0.ps), but since this is
  326. % the only thing that would be in that file, it's simpler to put it here.
  327. /.buildfont0 where { pop buildfontdict 0 /.buildfont0 cvx put } if
  328.  
  329. % Define definefont.  This is a procedure built on a set of operators
  330. % that do all the error checking and key insertion.
  331. /.growfontdict
  332.  {    % Grow the font dictionary, if necessary, to ensure room for an
  333.     % added entry, making sure there is at least one slot left for FID.
  334.    dup maxlength 1 index length sub 2 lt
  335.     { dup dup wcheck
  336.        { .growdict }
  337.        { .growdictlength dict .copydict }
  338.       ifelse
  339.     }
  340.     { dup wcheck not { dup maxlength dict .copydict } if
  341.     }
  342.    ifelse
  343.  } bind def 
  344. /.completefont {
  345.   {        % Check for disabled platform fonts.
  346.       NOPLATFONTS
  347.        {    % Make sure we leave room for FID.
  348.      .growfontdict dup /ExactSize 0 put
  349.        }
  350.        {    % Hack: if the Encoding looks like it might be the
  351.         % Symbol or Dingbats encoding, load those now (for the
  352.         % benefit of platform font matching) just in case
  353.         % the font didn't actually reference them.
  354.         % Note that some types of font don't have an Encoding.
  355.      dup /Encoding .knownget {
  356.        dup length 65 ge {
  357.          64 get
  358.          dup /congruent eq { SymbolEncoding pop } if
  359.          /a9 eq { DingbatsEncoding pop } if
  360.        } {
  361.          pop
  362.        } ifelse
  363.      } if
  364.        }
  365.       ifelse
  366.       true exch
  367.         % If this is a CIDFont, CIDFontType takes precedence
  368.         % over FontType.
  369.       dup /CIDFontType known {
  370.     /.buildcidfont where {
  371.       pop exch not exch    % true => false
  372.     } if
  373.       } if
  374.       exch {
  375.     dup /FontType get //buildfontdict exch get exec
  376.       } {
  377.     .buildcidfont
  378.       } ifelse
  379.  
  380.       DISKFONTS
  381.        { FontFileDirectory 2 index known
  382.       { dup /FontFile FontFileDirectory 4 index get .growput
  383.       }
  384.      if
  385.        }
  386.       if
  387.       readonly        % stack: name fontdict
  388.   } stopped { /invalidfont signalerror } if
  389. } bind odef
  390. /definefont
  391.  { .completefont
  392.         % If the current allocation mode is global, also enter
  393.         % the font in LocalFontDirectory.
  394.    .currentglobal
  395.     { //systemdict /LocalFontDirectory .knownget
  396.        { 2 index 2 index .growput }
  397.       if
  398.     }
  399.    if
  400.    dup .FontDirectory 4 -2 roll .growput
  401.         % If the font originated as a resource, register it.
  402.    currentfile .currentresourcefile eq { dup .registerfont } if
  403.  } odef
  404.  
  405. % Define a procedure for defining aliased fonts.
  406. % We use this only for explicitly aliased fonts, not substituted fonts:
  407. % we think this matches the observed behavior of Adobe interpreters.
  408. /.aliasfont        % <name> <font> .aliasfont <newFont>
  409.  { .currentglobal 3 1 roll dup .gcheck .setglobal
  410.    dup length 2 add dict
  411.    dup 3 -1 roll { 1 index /FID eq { pop pop } { put dup } ifelse } forall
  412.         % Stack: global fontname newfont newfont.
  413.         % We might be defining a global font whose FontName
  414.         % is a local string.  This is weird, but legal,
  415.         % and doesn't cause problems anywhere else:
  416.         % to avoid any possible problems in this case, do a cvn.
  417.         % We might also be defining (as an alias) a global font
  418.         % whose FontName is a local non-string, if someone passed a
  419.         % garbage value to findfont.  In this case, just don't
  420.         % call definefont at all.
  421.    2 index dup type /stringtype eq exch .gcheck or 1 index .gcheck not or
  422.     { /FontName 3 index dup type /stringtype eq { cvn } if put
  423.         % Don't bind in definefont, since Level 2 redefines it.
  424.       /definefont .systemvar exec
  425.     }
  426.     { .completefont pop exch pop
  427.     }
  428.    ifelse exch .setglobal
  429.  } odef        % so findfont will bind it
  430.  
  431. % Define .loadfontfile for loading a font.  If we recognize Type 1 and/or
  432. % TrueType fonts, gs_type1.ps and/or gs_ttf.ps will redefine this.
  433. /.loadfontfile {
  434.         % According to Ed Taft, Adobe interpreters push userdict
  435.         % before loading a font, and pop it afterwards.
  436.   userdict begin
  437.     cvx exec
  438.   end
  439. } bind def
  440. /.loadfont
  441.  {        % Some buggy fonts leave extra junk on the stack,
  442.         % so we have to make a closure that records the stack depth
  443.         % in a fail-safe way.
  444.    {{.loadfontfile} .execasresource} count 1 sub 2 .execn
  445.    count exch sub { pop } repeat
  446.  } bind def
  447.  
  448. % Find an alternate font to substitute for an unknown one.
  449. % We go to some trouble to parse the font name and extract
  450. % properties from it.  Later entries take priority over earlier.
  451. /.substitutefaces [
  452.     % Guess at suitable substitutions for random unknown fonts.
  453.   [(Book) /NewCenturySchlbk 0]
  454.   [(Grot) /Helvetica 0]
  455.   [(Roman) /Times 0]
  456.   [(Chancery) /ZapfChancery-MediumItalic 0]
  457.     % If the family name appears in the font name,
  458.     % use a font from that family.
  459.   [(Arial) /Helvetica 0]
  460.   [(Avant) /AvantGarde 0]
  461.   [(Bookman) /Bookman 0]
  462.   [(Century) /NewCenturySchlbk 0]
  463.   [(Cour) /Courier 0]
  464.   [(Frut) /Helvetica 0]
  465.   [(Garamond) /Palatino 0]
  466.   [(Geneva) /Helvetica 0]
  467.   [(Helv) /Helvetica 0]
  468.   [(NewYork) /Bookman 0]
  469.   [(Pala) /Palatino 0]
  470.   [(Schlbk) /NewCenturySchlbk 0]
  471.   [(Swiss) /Helvetica 0]
  472.   [(Symbol) /Symbol 0]
  473.   [(Times) /Times 0]
  474.     % Substitute for Adobe Multiple Master fonts.
  475.   [(Minion) /Times 0]
  476.   [(Myriad) /Helvetica 0]
  477.     % If the font wants to be monospace, use Courier.
  478.   [(Monospace) /Courier 0]
  479.   [(Typewriter) /Courier 0]
  480.     % Define substitutes for the other Adobe PostScript 3 fonts.
  481.     % For some of them, the substitution is pretty bad!
  482.   [(Albertus) /Palatino 0]
  483.   [(AntiqueOlive) /Helvetica 0]
  484.   [(Bodoni) /NewCenturySchlbk 0]
  485.   [(Chicago) /Helvetica 2]
  486.   [(Clarendon) /Bookman 0]
  487.   [(Cooper) /NewCenturySchlbk 0]
  488.   [(Copperplate) /AvantGarde 0]    % inappropriate, small-cap font
  489.   [(Coronet) /ZapfChancery-MediumItalic 0]
  490.   [(Eurostile) /Helvetica 0]
  491.   [(Geneva) /Courier 2]        % should be fixed-pitch sans demi
  492.   [(GillSans) /Helvetica 2]
  493.   [(GillSans-Light) /Helvetica 0]
  494.   [(Goudy) /Palatino 0]
  495.   [(Hoefler) /NewCenturySchlbk 0]
  496.   [(Joanna) /Times 0]
  497.   [(LetterGothic) /Courier 0]    % should be fixed-pitch sans
  498.   [(LubalinGraph-Book) /Bookman 2]
  499.   [(LubalinGraph-Demi) /Bookman 0]
  500.   [(Marigold) /ZapfChancery-MediumItalic 0]
  501.   [(MonaLisa-Recut) /Palatino 0]    % inappropriate
  502.   [(Monaco) /Courier 2]        % should be fixed-pitch sans demi
  503.   [(Optima) /Helvetica 0]
  504.   [(Oxford) /ZapfChancery-MediumItalic 0]
  505.   [(Tekton) /Helvetica 0]
  506.   [(Univers) /Helvetica 0]
  507. ] readonly def
  508. /.substituteproperties [
  509.   [(It) 9] [(Oblique) 1]
  510.   [(Black) 2] [(Bd) 2] [(Bold) 2] [(bold) 2] [(Demi) 2] [(Heavy) 2] [(Sb) 2]
  511.   [(Cn) 4] [(Cond) 4] [(Narrow) 4] [(Pkg) 4] [(Compr) 4]
  512.   [(Serif) 8] [(Sans) -8]
  513. ] readonly def
  514. /.fontnameproperties {        % <int> <string|name> .fontnameproperties
  515.                 %   <int'>
  516.   .fontnamestring
  517.   .substituteproperties {
  518.     2 copy 0 get search {
  519.       pop pop pop dup length 1 sub 1 exch getinterval 3 -1 roll exch {
  520.     dup 0 ge { or } { neg not and } ifelse
  521.       } forall exch
  522.     } {
  523.       pop pop
  524.     } ifelse
  525.   } forall pop
  526. } bind def
  527. /.substitutefamilies mark
  528.   /AvantGarde
  529.     {/AvantGarde-Book /AvantGarde-BookOblique
  530.      /AvantGarde-Demi /AvantGarde-DemiOblique}
  531.   /Bookman
  532.     {/Bookman-Demi /Bookman-DemiItalic /Bookman-Light /Bookman-LightItalic}
  533.   /Courier
  534.     {/Courier /Courier-Oblique /Courier-Bold /Courier-BoldOblique}
  535.   /Helvetica
  536.     {/Helvetica /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique
  537.      /Helvetica-Narrow /Helvetica-Narrow-Oblique
  538.      /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique}
  539.   /NewCenturySchlbk
  540.     {/NewCenturySchlbk-Roman /NewCenturySchlbk-Italic
  541.      /NewCenturySchlbk-Bold /NewCenturySchlbk-BoldItalic}
  542.   /Palatino
  543.     {/Palatino-Roman /Palatino-Italic /Palatino-Bold /Palatino-BoldItalic}
  544.   /Symbol
  545.     {/Symbol /Symbol /Symbol /Symbol}
  546.   /Times
  547.     {/Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic}
  548.   /ZapfChancery-MediumItalic
  549.     {/ZapfChancery-MediumItalic}
  550. .dicttomark readonly def
  551. /.nametostring {        % <name> .nametostring <string>
  552.                 % <other> .nametostring <other>
  553.   dup type /nametype eq { .namestring } if
  554. } bind def
  555. /.fontnamestring {        % <fontname> .fontnamestring <string|name>
  556.   dup type dup /nametype eq {
  557.     pop .namestring
  558.   } {
  559.     /stringtype ne { pop () } if
  560.   } ifelse
  561. } bind def
  562. /.substitutefontname {        % <fontname> <properties> .substitutefontname
  563.                 %   <altname|null>
  564.     % Look for properties and/or a face name in the font name.
  565.     % If we find any, use Times (serif) or Helvetica (sans) as the
  566.     % base font; otherwise, use the default font.
  567.     % Note that the "substituted" font name may be the same as
  568.     % the requested one; the caller must check this.
  569.   exch .fontnamestring {
  570.     defaultfontname /Helvetica-Oblique /Helvetica-Bold /Helvetica-BoldOblique
  571.     /Helvetica-Narrow /Helvetica-Narrow-Oblique
  572.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  573.     /Times-Roman /Times-Italic /Times-Bold /Times-BoldItalic
  574.     /Helvetica-Narrow /Helvetica-Narrow-Oblique
  575.     /Helvetica-Narrow-Bold /Helvetica-Narrow-BoldOblique
  576.   } 3 1 roll
  577.     % Stack: facelist properties fontname
  578.     % Look for a face name.
  579.   .substitutefaces {
  580.     2 copy 0 get search {
  581.       pop pop pop
  582.     % Stack: facelist properties fontname [(pattern) family properties]
  583.       dup 2 get 4 -1 roll or 3 1 roll
  584.       1 get .substitutefamilies exch get
  585.       4 -1 roll pop 3 1 roll
  586.     } {
  587.       pop pop
  588.     } ifelse
  589.   } forall pop
  590.   1 index length mod get exec
  591. } bind def
  592. /.substitutefont {        % <fontname> .substitutefont <altname>
  593.   dup 0 exch .fontnameproperties .substitutefontname
  594.     % Only accept fonts known in the Fontmap.
  595.    Fontmap 1 index known not { pop defaultfontname } if
  596. } bind def
  597.  
  598. % If requested, make (and recognize) fake entries in FontDirectory for fonts
  599. % present in Fontmap but not actually loaded.  Thanks to Ray Johnston for
  600. % the idea behind this code.
  601. FAKEFONTS not { (%END FAKEFONTS) .skipeof } if
  602.  
  603. % We use the presence or absence of the FontMatrix key to indicate whether
  604. % a font is real or fake.  We must pop the arguments at the very end,
  605. % so that stack protection will be effective.
  606.  
  607. /definefont {        % <name> <font> definefont <font>
  608.   dup /FontMatrix known {
  609.     //definefont
  610.   } {
  611.     2 copy /FontName get findfont //definefont exch pop exch pop
  612.   } ifelse
  613. } bind odef
  614.  
  615. /scalefont {        % <font> <scale> scalefont <font>
  616.   1 index /FontMatrix known {
  617.     //scalefont
  618.   } {
  619.     1 index /FontName get findfont 1 index //scalefont
  620.     exch pop exch pop
  621.   } ifelse
  622. } bind odef
  623.  
  624. /makefont {        % <font> <matrix> makefont <font>
  625.   1 index /FontMatrix known {
  626.     //makefont
  627.   } {
  628.     1 index /FontName get findfont 1 index //makefont
  629.     exch pop exch pop
  630.   } ifelse
  631. } bind odef
  632.  
  633. /setfont {        % <font> setfont -
  634.   dup /FontMatrix known {
  635.     //setfont
  636.   } {
  637.     dup /FontName get findfont //setfont pop
  638.   } ifelse
  639. } bind odef
  640.  
  641. %END FAKEFONTS
  642.  
  643. % Define findfont so it tries to load a font if it's not found.
  644. % The Red Book requires that findfont be a procedure, not an operator,
  645. % but it still needs to restore the stacks reliably if it fails,
  646. % so we do all the work in an operator.
  647. /.findfont {
  648.   mark 1 index
  649.   //systemdict begin .dofindfont
  650.     % Define any needed aliases.
  651.   counttomark 1 sub { .aliasfont } repeat end
  652.   exch pop exch pop
  653. } odef
  654. /findfont {
  655.   .findfont
  656. } bind def
  657. % Check whether the font name we are about to look for is already on the list
  658. % of aliases we're accumulating; if so, cause an error.
  659. /.checkalias        % -mark- <alias1> ... <name> .checkalias <<same>>
  660.  { counttomark 1 sub -1 1
  661.     { index 1 index eq
  662.        { pop QUIET not
  663.       { (Unable to substitute for font.) = flush
  664.       } if
  665.      /findfont cvx /invalidfont signalerror
  666.        }
  667.       if
  668.     }
  669.    for
  670.  } bind def
  671. % Get a (non-fake) font if present in a FontDirectory.
  672. /.fontknownget        % <fontdir> <fontname> .fontknownget <font> true
  673.             % <fontdir> <fontname> .fontknownget false
  674.  { .knownget
  675.     { FAKEFONTS
  676.        { dup /FontMatrix known { true } { pop false } ifelse }
  677.        { true }
  678.       ifelse
  679.     }
  680.     { false
  681.     }
  682.    ifelse
  683.  } bind def
  684. % This is the standard procedure for handling font substitution.
  685. % Its location is per an Adobe newsgroup posting.
  686. % It is called with the font name on the stack, standing in for findfont.
  687. /.stdsubstfont {    % mark <alias1> ... <fontname> .stdsubstfont <font>
  688.       /SUBSTFONT where {
  689.     pop QUIET not {
  690.       (Substituting for font ) print dup =only
  691.       (.) = flush
  692.     } if
  693.             % No aliasing.
  694.     cleartomark mark defaultfontname
  695.       } {
  696.     dup .substitutefont
  697.     2 copy eq { pop defaultfontname } if
  698.     .checkalias
  699.     QUIET not {
  700.       SHORTERRORS {
  701.         (%%[) print 1 index =only
  702.         ( not found, substituting ) print dup =only (]%%)
  703.       } {
  704.         (Substituting font ) print dup =only
  705.         ( for ) print 1 index =only (.)
  706.       } ifelse = flush
  707.     } if
  708.             % Remove all the accumulated aliases.
  709.     counttomark 1 add 1 roll cleartomark mark exch
  710.       } ifelse
  711.   .dofindfont
  712. } bind def
  713. $error /SubstituteFont { .stdsubstfont } put
  714. % Scan the next directory on FONTPATH.
  715. /.scannextfontdir {    % - .scannextfontdir <bool>
  716.             % If we haven't scanned all the directories in
  717.             % FONTPATH, scan the next one.
  718.   null 0 1 FONTPATH length 1 sub {
  719.     FONTPATH 1 index get null ne { exch pop exit } if pop
  720.   } for dup null ne {
  721.     dup 0 eq { .scanfontbegin } if
  722.     FONTPATH 1 index get .scanfontdir
  723.     FONTPATH exch null put true
  724.   } {
  725.     pop false
  726.   } ifelse
  727. } bind def
  728. % Do the work of findfont, including substitution, defaulting, and
  729. % scanning of FONTPATH.
  730. /.dofindfont {        % <fontname> .dofindfont <font>
  731.   .tryfindfont not {
  732.             % We didn't find the font.  If we haven't scanned
  733.             % all the directories in FONTPATH, scan the next one
  734.             % now and look for the font again.
  735.     .scannextfontdir {
  736.             % Start over with an empty alias list.
  737.       counttomark 1 sub { pop } repeat
  738.       .dofindfont
  739.     } {
  740.             % No luck.  Make sure we're not already
  741.             % looking for the default font.
  742.       dup defaultfontname eq {
  743.     QUIET not {
  744.       (Unable to load default font ) print
  745.       dup =only (!  Giving up.) = flush
  746.     } if
  747.     /findfont cvx /invalidfont signalerror
  748.       } if
  749.             % Substitute for the font.  Don't alias.
  750.       $error /SubstituteFont get exec
  751.     } ifelse
  752.   } if
  753. } bind def
  754. % Try to find a font using only the present contents of Fontmap.
  755. /.tryfindfont {        % <fontname> .tryfindfont <font> true
  756.             % <fontname> .tryfindfont false
  757.   .FontDirectory 1 index .fontknownget
  758.     {            % Already loaded
  759.       exch pop true
  760.     }
  761.     { dup Fontmap exch .knownget not
  762.        {        % Unknown font name.  Look for a file with the
  763.             % same name as the requested font.
  764.      .tryloadfont
  765.        }
  766.        {        % Try each element of the Fontmap in turn.
  767.      false exch    % (in case we exhaust the list)
  768.             % Stack: fontname false fontmaplist
  769.      { exch pop
  770.        dup type /nametype eq
  771.         {            % Font alias
  772.           .checkalias .tryfindfont exit
  773.         }
  774.         { dup dup type dup /arraytype eq exch /packedarraytype eq or exch xcheck and
  775.            {        % Font with a procedural definition
  776.          exec        % The procedure will load the font.
  777.                 % Check to make sure this really happened.
  778.          .FontDirectory 1 index .knownget
  779.           { exch pop true exit }
  780.          if
  781.            }
  782.            {        % Font file name
  783.          .loadfontloop { true exit } if
  784.            }
  785.           ifelse
  786.         }
  787.        ifelse false
  788.      }
  789.      forall
  790.             % Stack: font true -or- fontname false
  791.      { true
  792.      }
  793.      {            % None of the Fontmap entries worked.
  794.                 % Try loading a file with the same name
  795.                 % as the requested font.
  796.        .tryloadfont
  797.      }
  798.     ifelse
  799.        }
  800.       ifelse
  801.     }
  802.    ifelse
  803.  } bind def
  804. % Attempt to load a font from a file.
  805. /.tryloadfont {        % <fontname> .tryloadfont <font> true
  806.             % <fontname> .tryloadfont false
  807.   dup .nametostring
  808.         % Hack: check for the presence of the resource machinery.
  809.   /.genericrfn where {
  810.     pop
  811.     2 copy .fonttempstring /FontResourceDir getsystemparam .genericrfn
  812.     .loadfontloop {
  813.       exch pop exch pop true
  814.     } {
  815.       dup .nametostring .loadfontloop
  816.     } ifelse
  817.   } {
  818.     .loadfontloop
  819.   } ifelse
  820. } bind def
  821. /.loadfontloop {    % <fontname> <filename> .loadfontloop
  822.             %   <font> true
  823.             % -or-
  824.             %   <fontname> false
  825.             % See above regarding the use of 'loop'.
  826.     {
  827.             % Is the font name a string?
  828.     dup type /stringtype ne
  829.      { QUIET not
  830.         { (Can't find font with non-string name: ) print dup =only (.) = flush
  831.         }
  832.        if pop false exit
  833.      }
  834.     if
  835.             % Can we open the file?
  836.     findlibfile not
  837.      { QUIET not
  838.         { (Can't find \(or can't open\) font file ) print dup print
  839.           (.) = flush
  840.         }
  841.        if pop false exit
  842.      }
  843.     if
  844.  
  845.             % Stack: fontname fontfilename fontfile
  846.     DISKFONTS
  847.      { .currentglobal true .setglobal
  848.        2 index (r) file
  849.        FontFileDirectory exch 5 index exch .growput
  850.        .setglobal
  851.      }
  852.     if
  853.     QUIET not
  854.      { (Loading ) print 2 index =only
  855.        ( font from ) print 1 index print (... ) print flush
  856.      }
  857.     if
  858.     % If LOCALFONTS isn't set, load the font into local or global
  859.     % VM according to FontType; if LOCALFONTS is set, load the font
  860.     % into the current VM, which is what Adobe printers (but not
  861.     % DPS or CPSI) do.
  862.     LOCALFONTS { false } { /setglobal where } ifelse
  863.      { pop /FontType .findfontvalue { 1 eq } { false } ifelse
  864.         % .setglobal, like setglobal, aliases FontDirectory to
  865.         % GlobalFontDirectory if appropriate.  However, we mustn't
  866.         % allow the current version of .setglobal to be bound in,
  867.         % because it's different depending on language level.
  868.        .currentglobal exch /.setglobal .systemvar exec
  869.         % Remove the fake definition, if any.
  870.        .FontDirectory 3 index .undef
  871.        1 index (r) file .loadfont .FontDirectory exch
  872.        /.setglobal .systemvar exec
  873.      }
  874.      { .loadfont .FontDirectory
  875.      }
  876.     ifelse
  877.         % Stack: fontname fontfilename fontdirectory
  878.     QUIET not
  879.      { //systemdict /level2dict known
  880.         { .currentglobal false .setglobal vmstatus
  881.           true .setglobal vmstatus 3 -1 roll pop
  882.           6 -1 roll .setglobal 5
  883.         }
  884.         { vmstatus 3
  885.         }
  886.        ifelse { =only ( ) print } repeat
  887.        (done.) = flush
  888.      } if
  889.  
  890.         % Check to make sure the font was actually loaded.
  891.     dup 3 index .fontknownget
  892.      { 4 1 roll pop pop pop true exit } if
  893.  
  894.         % Maybe the file had a different FontName.
  895.         % See if we can get a FontName from the file, and if so,
  896.         % whether a font by that name exists now.
  897.     exch (r) file .findfontname
  898.      { 2 copy .fontknownget
  899.         {    % Yes.  Stack: origfontname fontdirectory filefontname fontdict
  900.           3 -1 roll pop exch
  901.           QUIET
  902.            { pop
  903.            }
  904.            { (Using ) print =only
  905.              ( font for ) print 1 index =only
  906.              (.) = flush
  907.            }
  908.           ifelse true exit
  909.         }
  910.        if pop
  911.      }
  912.     if pop
  913.  
  914.         % The font definitely did not load correctly.
  915.     QUIET not
  916.      { (Loading ) print dup =only
  917.        ( font failed.) = flush
  918.      } if
  919.     false exit
  920.  
  921.     } loop        % end of loop
  922.  
  923.  } bind def
  924.  
  925. % Define a procedure to load all known fonts.
  926. % This isn't likely to be very useful.
  927. /loadallfonts
  928.  { Fontmap { pop findfont pop } forall
  929.  } bind def
  930.  
  931. % If requested, load all the fonts defined in the Fontmap into FontDirectory
  932. % as "fake" fonts i.e., font dicts with only FontName and FontType defined.
  933. % (We define FontType only for the sake of some questionable code in the
  934. % Apple Printer Utility 2.0 font inquiry code.)
  935. %
  936. % Note that this procedure only creates fake fonts in the FontDirectory
  937. % associated with the current VM.  This is because in multi-context systems,
  938. % creating the fake fonts in local VM leads to undesirable complications.
  939. /.definefakefonts
  940.     {
  941.     }
  942.     {
  943.       (gs_fonts FAKEFONTS) VMDEBUG
  944.       Fontmap {
  945.     pop dup type /stringtype eq { cvn } if
  946.     .FontDirectory 1 index known not {
  947.       2 dict dup /FontName 3 index put
  948.       dup /FontType 1 put
  949.       .FontDirectory 3 1 roll put
  950.     } {
  951.       pop
  952.     } ifelse
  953.       } forall
  954.     }
  955. FAKEFONTS { exch } if pop def    % don't bind, .current/setglobal get redefined
  956.  
  957. % Install initial fonts from Fontmap.
  958. /.loadinitialfonts
  959.  { NOFONTMAP not
  960.     { /FONTMAP where
  961.       { pop [ FONTMAP .pathlist ]
  962.          { dup VMDEBUG findlibfile
  963.         { exch pop .loadFontmap }
  964.         { /undefinedfilename signalerror }
  965.            ifelse
  966.          }
  967.       }
  968.       { LIBPATH
  969.          { defaultfontmap 2 copy .filenamedirseparator
  970.            exch concatstrings concatstrings dup VMDEBUG
  971.            (r) { file } .internalstopped
  972.         { pop pop } { .loadFontmap } ifelse
  973.          }
  974.       }
  975.      ifelse forall
  976.     }
  977.    if
  978.    .definefakefonts    % current VM is global
  979.  } def            % don't bind, .current/setglobal get redefined
  980.  
  981. % ---------------- Synthetic font support ---------------- %
  982.  
  983. % Create a new font by modifying an existing one.  paramdict contains
  984. % entries with the same keys as the ones found in a Type 1 font;
  985. % it should also contain enough empty entries to allow adding the
  986. % corresponding non-overridden entries from the original font dictionary,
  987. % including FID.  If paramdict includes a FontInfo entry, this will
  988. % also override the original font's FontInfo, entry by entry;
  989. % again, it must contain enough empty entries.
  990.  
  991. % Note that this procedure does not perform a definefont.
  992.  
  993. /.makemodifiedfont    % <fontdict> <paramdict> .makemodifiedfont <fontdict'>
  994.  { exch
  995.     {            % Stack: destdict key value
  996.       1 index /FID ne
  997.        { 2 index 2 index known
  998.       {        % Skip fontdict entry supplied in paramdict, but
  999.             % handle FontInfo specially.
  1000.         1 index /FontInfo eq
  1001.          { 2 index 2 index get        % new FontInfo
  1002.            1 index                % old FontInfo
  1003.         {    % Stack: destdict key value destinfo key value
  1004.           2 index 2 index known
  1005.            { pop pop }
  1006.            { 2 index 3 1 roll put }
  1007.           ifelse
  1008.         }
  1009.            forall pop
  1010.          }
  1011.         if
  1012.       }
  1013.       {        % No override, copy the fontdict entry.
  1014.         2 index 3 1 roll put
  1015.         dup dup    % to match pop pop below
  1016.       }
  1017.      ifelse
  1018.        }
  1019.       if
  1020.       pop pop
  1021.     } forall
  1022.  } bind def
  1023.  
  1024. % Make a modified font and define it.  Note that unlike definefont,
  1025. % this does not leave the font on the operand stack.
  1026.  
  1027. /.definemodifiedfont    % <fontdict> <paramdict> .definemodifiedfont -
  1028.  { .makemodifiedfont
  1029.    dup /FontName get exch definefont pop
  1030.  } bind def
  1031.